curatptid dw 0
;
bdsptr equ cmndlist+2
;
atprq.result equ 1
atprq.dymsckt equ 4
atprq.dnet equ 5
atprq.dnode equ 7
atprq.dsckt equ 8
atprq.flag equ 9
atprq.bitmap equ 10
atprq.tid equ 11
atprq.sndbds equ 13
atprq.rbdsad equ 15
atprq.rbnum equ 17
atprq.response equ 18
atprq.timeout equ 19
atprq.rtrycnt equ 20
atprq.timleft equ 21
atprq.tryleft equ 22
;
 do savespace
;
decindy sec
 lda (cmndlist),y
 sbc #1
 sta (cmndlist),y
 rts
;
incindy clc
 lda (cmndlist),y
 adc #1
 sta (cmndlist),y
 rts
 fin
;
;
;
sndatprq equ *
 php
 sei
 ldx #atprqtblsiz+atprqtblsiz-2 ; end of table
sndatpq.1 lda atprqtable+1,x ; search for available slot
 beq sndatpq.5 ; found
 dex
 dex
 bpl sndatpq.1 ; continue if more 
toomanyproc lda #toomanyreq ; otherwise we cannot do it yet
 jmp retasynflag
sndatpq.5 stx sndatpq.6+1 ; save x
 ldy #atprq.response
 lda #0
 sta (cmndlist),y ; no response yet
 ldx #>atplisten
 ldy #<atplisten
 jsr opensckt ; try to open a dynamic socket
 beq toomanyproc ; open failed
 ldy #atprq.dymsckt
 sta (cmndlist),y
sndatpq.6 ldx #0 ; get back x
 lda cmndlist
 sta atprqtable,x
 lda cmndlist+1
 sta atprqtable+1,x
 ldy #atprq.tid+1
 inc curatptid+1
 lda curatptid+1 ; generate new transaction id
 sta (cmndlist),y
 bne *+5
 inc curatptid
 lda curatptid
 dey
 sta (cmndlist),y
 ldy #atprq.rtrycnt
 lda (cmndlist),y ; retry count
 ldy #atprq.tryleft
 sta (cmndlist),y
 jsr sndatrqpckt
 jmp waitdone
;
;
atptmpindex equ cmndlist+2
;
atplisten jsr rdatpheader ; read the 8 byte atp header, and calculate checksum
 bne atpl.rts ; if error, do nothing, carry flag already set
 lda atpheader ; check function code
 and #$c0
 cmp #$80 ; is it a reply ?
 bne noatp
 ldx #atprqbegin
 lda #atprqend
 ldy #0 ; ignore network number so that 0 and local net is equivalent
 sty rspcmptable+1
 sty rspcmptable+2
 jsr looktable ; search table for occupied slot
 bmi noatp ; not found
 lda atpheader+1
 ldy #atprq.rbnum
 cmp (cmndlist),y ; compare with nubmer of buffers
 bcc atls.0 ; ok
noatp sec ; discard data
atpl.rts rts
atls.0 tax
 lda onebitmask,x
 ldy #atprq.bitmap
 and (cmndlist),y ; do we want this one ?
 beq noatp ; no, throw it away
 txa
 asl a ; * 2
 asl a ; * 4, also clear carry
 adc atpheader+1 ; result is * 5
 asl a ; * 10
 ldy #atprq.rbdsad
 jsr readltdsize ; read it, but no more can buffer can accomdate
 bne atpclc
 ldy #atprq.response
 do savespace
 jsr incindy
 else
 clc
 lda #1
 adc (cmndlist),y
 sta (cmndlist),y ; increment receive count
 fin
 ldy #atprq.bitmap
 ldx atpheader+1
 lda atpheader
 and #atpeombit ; is it eom ?
 beq atls.8 ; no
 lda lowbitmask,x
 and (cmndlist),y
 jmp atls.9
atls.8 lda onebitmask,x
 eor (cmndlist),y
atls.9 sta (cmndlist),y
 php
 lda atpheader
 and #atpstsbit ; is it sts
 beq atls.10 ; no
 jsr sndatrqpckt ; send new bit map, do not consume retry
atls.10 plp
 bne atpclc
cancelatpreq lda #0
killrequest php
 sei
 ldy #1
 sta (cmndlist),y
 ldx #atprqend
 lda #atprqbegin
 jsr findtable ; see if it is in table
 bmi kilreq.9 ; not in table, ignore it
 lda #0
 sta processtable+1,x
 ldy #atprq.dymsckt
 lda (cmndlist),y
 jsr closeddpsckt ; remove the dynamic socket
 ldy #atprq.flag
 lda (cmndlist),y
 and #atpxobit ; is it xo
 beq kilreq.9 ; no
 lda #$c0 ; else release it
 jsr sndatppckt ; send release packet
kilreq.9 plp
 jsr chkiocmp ; do i/o completetion routine
atpclc clc
 rts
ratprest dfb 5
 dw 0,0
onebitmask dfb $01,$02,$04,$08,$10,$20,$40,$80
lowbitmask dfb $00,$01,$03,$07,$0f,$1f,$3f,$7f
;
;
readltdsize equ * ; read with size restriction
 do savespace
 jsr calcbdsadr
 else
 clc
 adc (cmndlist),y ; get bds
 sta bdsptr
 iny
 lda (cmndlist),y
 adc #0
 sta bdsptr+1
 fin
 ldy #6 ; copy four user bytes
rdltd.1 lda atpheader+4-6,y
 sta (bdsptr),y
 iny
 cpy #10
 bne rdltd.1
 ldy #3 ; get address of buffer
rdltd.2 lda (bdsptr),y
 sta ratprest-1,y
 dey
 cpy #1
 bne rdltd.2
rdltd.2a lda (bdsptr),y
 sta ratprest+3,y
 dey
 bpl rdltd.2a
 clc ; find the length of the rest of packet
 lda #-13
 ldx laptype
 dex ; is it short ddp
 beq *+4
 lda #-21 ; long ddp + atp header bytes
 adc ddphead+ld.length+1
 tax  ; save low byte in x
 ldy #4
 sta (bdsptr),y
 lda ddphead+ld.length
 and #3
 adc #$ff
 iny ; y = 5
 sta (bdsptr),y
 ldy #3
 cmp (bdsptr),y
 bcc rdltd.5 ; small packet
 bne rdltd.7 ; big packet
 dey ; same size, must compare low byte  y = 2
 txa  ; get back low byte of packet size
 cmp (bdsptr),y
 bcc rdltd.6 ; small packet
 bcs rdltd.7 ; exact size or too big
; packet is smaller than the buffer
rdltd.5 sta ratprest+4 ; high byte of length
rdltd.6 stx ratprest+3 ; low byte of length
rdltd.7 ldy #<ratprest
 ldx #>ratprest
 jsr readhdrsum ; read that many byte into buffer
 bne rdltd.8 ; should never happen, can be throw away if space is tight
 jsr discard
 lda chksmf
 beq rdltd.9
 lda curcksum ; check if checksum is correct
 cmp ddphead+ld.chksum
 bne rdltd.8
 lda curcksum+1
 cmp ddphead+ld.chksum+1
 beq rdltd.9
rdltd.8 lda #0
 ldy #4
 sta (bdsptr),y
 iny
 sta (bdsptr),y ; note that z was clear
rdltd.9 rts
;
;
;
atptimeout equ *
 lda #atprqend
 pha
atpqtim.1 pla ; find a slot that has atp operation
 tax
 dex
 dex
 txa
 cmp #rspcbbegin
 bmi rdltd.9
 pha
 lda processtable+1,x
 beq atpqtim.1
 sta cmndlist+1
 lda processtable,x
 sta cmndlist
 cpx #atprqbegin ; waiting for reply ?
 bcc atpqtim.5 ; no, then rspcb
 do savespace
 ldy #atprq.timleft
 jsr decindy
 else
 ldy #atprq.timleft
 lda (cmndlist),y
 sec
 sbc #1
 sta (cmndlist),y
 fin
 bne atpqtim.1
 ldy #atprq.tryleft
 lda (cmndlist),y
 beq atpqtim.4
 cmp #$ff ; infinite retry
 beq atpqtim.3 ; then do not decrement count
 do savespace
 jsr decindy
 else
 lda (cmndlist),y
 sec
 sbc #1
 sta (cmndlist),y
 fin
atpqtim.3 jsr sndatrqpckt ; send a atp request packet
 jmp atpqtim.1
atpqtim.4 lda #requestfail
 jsr killrequest
 jmp atpqtim.1
atpqtim.5 equ * ; check to find rspcb to release
 ldy #sdrsp.timer
 do savespace
 jsr decindy ; decrement timer
 else
 sec
 lda (cmndlist),y
 sbc #1
 sta (cmndlist),y
 fin
 bne atpqtim.1 ; timer still going
 lda #0
 sta processtable+1,x ; else remove the item
 ldy #1
 sta (cmndlist),y ; release the response command
 jsr chkiocmp ; do i/o completetion routine
 jmp atpqtim.1
;
; send an atp request packet
;
sndatrqpckt equ *
 ldy #atprq.timeout
 lda (cmndlist),y
 ldy #atprq.timleft
 sta (cmndlist),y
 ldy #atprq.flag
 lda (cmndlist),y ; get flags
 and #atpxobit
 ora #$40
; jsr sndatppckt ; fall through to send generic atp packet
; rts
;
; send an atp packet
;
sndatppckt sta atpheader
 ldy #atprq.bitmap
 lda (cmndlist),y
 sta atpheader+1
 lda #0
 jsr watppckt ; write it out
 beq sndatp.rts ; no error
 tax
 ldy #atprq.tryleft
 lda (cmndlist),y ; any more try left
 bne sndatp.rts ; yes, then ignore error
 txa
 jmp killrequest
sndatp.rts rts
;
;
;
watppckt equ *
 pha
 lda #3
 sta ddphead+ld.protocol ; atp is protocol 3
 ldy #atprq.dymsckt
 lda (cmndlist),y
 jsr setdestadr ; use parmeter list to set dest addr
 pla ; get back bds displacement
 ldy #atprq.sndbds
 do savespace
 jsr calcbdsadr
 else
 clc
 adc (cmndlist),y
 sta bdsptr
 iny
 lda #0
 adc (cmndlist),y
 sta bdsptr+1
 fin
 ldy #3
sdrsp.4 lda (bdsptr),y
 sta atprqwds+8,y
 dey
 bpl sdrsp.4
 ldy #6
sdrsp.5 lda (bdsptr),y
 sta atpheader+4-6,y
 iny
 cpy #10
 bcc sdrsp.5
 ldy #atprq.tid
 lda (cmndlist),y
 sta atpheader+2
 iny
 lda (cmndlist),y
 sta atpheader+3
 ldx #>atprqwds
 ldy #<atprqwds
 jmp dowrtddp ; if we want to save 3 bytes, we can fall thru to dowrtddp
;
 do savespace
calcbdsadr clc
 adc (cmndlist),y
 sta bdsptr
 iny
 lda #0
 adc (cmndlist),y
 sta bdsptr+1
 rts
 fin
;
atprqwds ds 4,0
 dw 8,atpheader
 ds 4,0
 dw $ffff
;
ratpparm dfb 5
 dw atpheader
 dw 8
